home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form VCIChildForm
- BackColor = &H80000005&
- Caption = "Sheet"
- ClientHeight = 2280
- ClientLeft = 1350
- ClientTop = 2040
- ClientWidth = 7335
- ForeColor = &H80000008&
- Height = 2745
- Icon = "VTIChild.frx":0000
- Left = 1260
- LinkTopic = "Form1"
- MDIChild = -1 'True
- ScaleHeight = 2280
- ScaleWidth = 7335
- Top = 1665
- Width = 7515
- Begin VCIF1Lib.F1Book SS
- Height = 2295
- Left = 0
- TabIndex = 0
- Top = 0
- Width = 7335
- _version = 65536
- _extentx = 12938
- _extenty = 4048
- _stockprops = 96
- borderstyle = 1
- tablename = "F1Book1"
- appname = ""
- filename = "VTIChild.frx":044A
- mouseicon = "VTIChild.frx":0A5D
- End
- Attribute VB_Name = "VCIChildForm"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Option Compare Text
- Private Sub UpdateLockStatus()
- MainFrame.FormatEnableProtection.Checked = SS.EnableProtection
- End Sub
- Private Sub UpdateZoom()
- Dim i%
- Dim TheZoom$
- '' Set the Zoom factor
- TheZoom = Format$(SS.ViewScale, "##0\%")
- For i = 0 To MainFrame.cboZoom.ListCount
- If StrComp(TheZoom, MainFrame.cboZoom.List(i)) = 0 Then
- MainFrame.cboZoom.ListIndex = i
- Exit For
- End If
- Next i
- End Sub
- Private Sub Form_Activate()
- '' Create the sheet name of blank sheets by adding
- '' the next available number to the name "Sheet"
- If Caption = "Sheet" Then
- gNewSSCount = gNewSSCount + 1
- Caption = Caption & gNewSSCount
- SS.TableName = Caption
- SS.ShowEditBar = True
- End If
- ' Update toolbar color display
- Call UpdateTextAndFillColors
- End Sub
- Private Sub Form_Load()
- Dim Er As Integer
- '' Whenever a child form loads create a matching
- '' spreadsheet
- Er = SS.InitTable
- Call UpdateCBOFontAndSize
- Call UpdateZoom
- Call UpdateLockStatus ' Updates the lock status of the selection
- End Sub
- Private Sub Form_Resize()
- '' Expand the worksheet to fill the child window
- SS.Top = 0
- SS.Left = 0
- SS.Width = ScaleWidth
- SS.Height = ScaleHeight
- End Sub
- Private Sub SS_GotFocus()
- Call Paint_Reference ' Update Row/Col Reference Display
- Call UpdateCBOFontAndSize ' Set the font for the current selection
- Call UpdateFace ' Set buttons for selction font face
- Call UpdateAlignment ' Set buttons according to selection alignment
- Call UpdateZoom ' Update zoom factor
- Call UpdateLockStatus ' Updates the lock status of the selection
- If SS.PolyEditMode = F1PolyEditModePoints Then
- MainFrame.imgEditPoly.Visible = False
- Else
- MainFrame.imgEditPoly.Visible = True
- End If
- End Sub
- Private Sub SS_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
- Dim SS As Object
- Dim TheRow As Long, TheCol As Long
- Dim TheString As String
- Dim LockedFlag As Boolean, HiddenFlag As Boolean
- Dim TheRule As String, TheMessage As String
- Dim OriginRow%, OriginCol%, DestinRow%, DestinCol%
- Dim fpDestinStartRow%, fpDestinEndRow%, fpDestinStartCol%, fpDestinEndCol%
- Dim TheFormat$
- Dim Pattern%
- Dim crFG&, crBG&
- Dim Horizontal%, Vertical%, Orientation%
- Dim WordWrap As Boolean
- Dim pOutline%, pLeft%, pRight%, pTop%, pBottom%, pShade%
- Dim crOutline&, crLeft&, crRight&, crTop&, crBottom&
- Dim pFont$
- Dim pSize%
- Dim pBold As Boolean, pItalic As Boolean, pUnderline As Boolean, pStrikeout As Boolean
- Dim crColor&
- Dim pFOutline As Boolean, pShadow As Boolean
- Set SS = MainFrame.ActiveForm.SS
- ' If button one and if we are in the format painter mode
- If Button = 1 Then
- If FormatPainterFlag = 2 Then
-
- ' Turn off the Selection Change Event so we don't do all the
- ' toolbar updating while formatting.
- SS.DoSelChange = False
-
- SS.MousePointer = F1Default ' Turn default Pointer back on
-
- fpDestinStartRow = SS.SelStartRow
- fpDestinStartCol = SS.SelStartCol
- fpDestinEndRow = SS.SelEndRow
- fpDestinEndCol = SS.SelEndCol
-
- OriginRow = FmtPntStartRow
- For DestinRow = fpDestinStartRow To fpDestinEndRow
- OriginCol = FmtPntStartCol
- For DestinCol = fpDestinStartCol To fpDestinEndCol
-
- ' Get the origin format
- SS.Row = OriginRow
- SS.Col = OriginCol
- SS.GetAlignment Horizontal, WordWrap, Vertical, Orientation
- SS.GetBorder pLeft, pRight, pTop, pBottom, pShade, crLeft, crRight, crTop, crBottom
- SS.GetFont pFont, pSize, pBold, pItalic, pUnderline, pStrikeout, crColor, pFOutline, pShadow
- SS.GetPattern Pattern, crFG, crBG
- TheFormat = SS.NumberFormat
-
- ' Set the new format
- SS.Row = DestinRow
- SS.Col = DestinCol
- SS.SetPattern Pattern, crFG, crBG
- SS.NumberFormat = TheFormat
- SS.SetAlignment Horizontal, WordWrap, Vertical, Orientation
- pOutline = -1
- crOutline = -1
- SS.SetBorder pOutline, pLeft, pRight, pTop, pBottom, pShade, crOutline, crLeft, crRight, crTop, crBottom
- SS.SetFont pFont, -pSize, pBold, pItalic, pUnderline, pStrikeout, crColor, pFOutline, pShadow
-
- OriginCol = OriginCol + 1
- If OriginCol > FmtPntEndCol Then OriginCol = FmtPntStartCol
-
- Next
-
- OriginRow = OriginRow + 1
- If OriginRow > FmtPntEndRow Then OriginRow = FmtPntStartRow
-
- Next
-
- ' Turn off format painter
- FormatPainterFlag = 0
- SS.DoSelChange = True
-
- End If
- ' Right button displays a cell description dialog
- Else
- ' Save the object into a variable to save on typing.
- SS.TwipsToRC x, y, TheRow, TheCol
- SS.Row = TheRow
- SS.Col = TheCol
- TheString = "Cell: " + SS.Selection + Chr$(10)
- TheString = TheString + "Value: " + Str$(SS.Number) + Chr$(10)
- TheString = TheString + "Format: " + SS.NumberFormat + Chr$(10)
- TheString = TheString + "Formula: " + SS.Formula + Chr$(10)
- SS.GetValidationRule TheRule, TheMessage
- TheString = TheString + "Validation Rule: " + TheRule + Chr$(10)
- TheString = TheString + "Validation Msg: " + TheMessage + Chr$(10)
- SS.GetProtection LockedFlag, HiddenFlag
- TheString = TheString + "Protection: " + IIf(LockedFlag, "Locked", "Unlocked") + Chr$(10)
- MsgBox TheString
- SS.SetFocus
- End If
- End Sub
- Private Sub SS_SelChange()
- Call Paint_Reference ' Update Row/Col Reference Display
- Call UpdateCBOFontAndSize ' Update the font and size cbos
- Call UpdateFace ' Set buttons for selction font face
- Call UpdateAlignment ' Set buttons according to selection alignment
- ' If the format painter command is active then set up for
- ' the mouseup event which will complete the command.
- If FormatPainterFlag = 1 Then
- FormatPainterFlag = 2
- MainFrame.ActiveForm.SS.SetFocus
- End If
- End Sub
- Private Sub UpdateAlignment()
- Dim WordWrap As Boolean
- Dim i%, Horizontal%, Vertical%, orient%
- For i = 0 To 3
- MainFrame.imgAlign(i).Visible = True
- Next i
- SS.GetAlignment Horizontal, WordWrap, Vertical, orient
- Select Case Horizontal
- Case F1HAlignLeft
- MainFrame.imgAlign(0).Visible = False
- Case F1HAlignCenter
- MainFrame.imgAlign(1).Visible = False
- Case F1HAlignRight
- MainFrame.imgAlign(2).Visible = False
- Case F1HAlignCenterAcrossCells
- MainFrame.imgAlign(3).Visible = False
- End Select
- End Sub
- Private Sub UpdateCBOFontAndSize()
- Dim i%
- Dim theFont$
- Dim ifBold As Boolean, ifItalic As Boolean, ifUnderline As Boolean, ifStrikeout As Boolean
- Dim ifOutline As Boolean, ifShadow As Boolean
- Dim theSize As Integer
- Dim TheColor&
- Dim sizeString$
- Let theFont = Space$(31)
- SS.GetFont theFont, theSize, ifBold, ifItalic, ifUnderline, ifStrikeout, TheColor, ifOutline, ifShadow
- ''Note that theSize comes back as zero every time
- For i = 0 To Screen.FontCount - 1
- If StrComp(theFont, MainFrame.cboFont.List(i)) = 0 Then
- GoTo FoundFont
- End If
- Next i
- '' Empty selection since font not found
- MainFrame.cboFont.ListIndex = -1
- MainFrame.cboSize.Text = ""
- Exit Sub
- FoundFont:
- MainFrame.cboFont.ListIndex = i
- MainFrame.cboSize.Text = Str(theSize / 20)
- End Sub
- Private Sub UpdateFace()
- Dim i%
- Dim theFont$
- Dim ifBold As Boolean, ifItalic As Boolean, ifUnderline As Boolean, ifStrikeout As Boolean
- Dim ifOutline As Boolean, ifShadow As Boolean
- Dim theSize%
- Dim TheColor&
- For i = 0 To 2
- MainFrame.imgFace(i).Visible = True
- Next i
- Let theFont = Space$(31)
- MainFrame.ActiveForm.SS.GetFont theFont, theSize, ifBold, ifItalic, ifUnderline, ifStrikeout, TheColor, ifOutline, ifShadow
- If ifBold Then '' Set the button faces as pressed down or
- MainFrame.imgFace(0).Visible = False '' popped up according to the current font
- End If '' variables of the active spreadsheet
- If ifItalic Then
- MainFrame.imgFace(1).Visible = False
- End If
- If ifUnderline Then
- MainFrame.imgFace(2).Visible = False
- End If
- End Sub
-